home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / preferences.tcl.z / preferences.tcl
Text File  |  2002-07-08  |  20KB  |  701 lines
  1. # pref.tcl
  2. #
  3. # User pref.  This uses a table-driven scheme to set a bunch
  4. # of variables in the rest of the application.  The results are
  5. # written out to a Xresources-style file that is read by Preferences_Init
  6. # at startup.
  7. #
  8. # Copyright (c) 1993 Xerox Corporation.
  9. # Use and copying of this software and preparation of derivative works based
  10. # upon this software are permitted. Any distribution of this software or
  11. # derivative works must comply with all applicable United States export
  12. # control laws. This software is made available AS IS, and Xerox Corporation
  13. # makes no warranty about the software, its performance or its conformity to
  14. # any specification.
  15.  
  16. # A two-level scheme is used
  17. # pref(panes) => list of preference windows
  18. # pref($p,text) => explainatory text
  19. # pref($p,prefs) => list of lists, each sublist looks like
  20. #    { varname xresname defaultValue Comment HelpMsg }
  21. # The varname can be a simple variable or an array element
  22. # The xresname is an Xresource specification
  23. # The defaultValue can be a list, which turns into a set of radio buttons
  24. # or it can be "ON" or "OFF", which turns into a check box
  25. # or if it is a single string, it turns into an entry containing that string
  26.  
  27.  
  28. proc PrefVar { item } { lindex $item 0 }
  29. proc PrefXres { item } { lindex $item 1 }
  30. proc PrefDefault { item } { lindex $item 2 }
  31. proc PrefComment { item } { lindex $item 3 }
  32. proc PrefHelp { item } { lindex $item 4 }
  33.  
  34. proc Preferences_Init { userDefaults appDefaults } {
  35.     global pref
  36.  
  37.     set pref(uid) 0
  38.     set pref(panes) {}
  39.     set pref(userDefaults) $userDefaults
  40.     set pref(appDefaults) $appDefaults
  41.     set pref(localDefaults) \
  42.     "[file dirname $appDefaults]/local.[file tail $appDefaults]"
  43.  
  44.     catch {exec mkdir -p [glob ~]/.exmh}
  45.  
  46.     if {[file exists [glob ~]/.exmh-defaults] 
  47.     && ![file exists $userDefaults]} { 
  48.     PreferencesCopyToNewLocation
  49.     }
  50.     
  51.     PreferencesReadFile $pref(appDefaults) startup
  52.     PreferencesReadFile $pref(localDefaults) 50
  53.     PreferencesReadFile $pref(userDefaults) user
  54.  
  55.     Preferences_Resource pref(helpInOneWindow) helpInOneWindow 1
  56. }
  57.  
  58. proc PreferencesCopyToNewLocation {} {
  59.     global pref exmh
  60.  
  61.     Widget_Toplevel .newprefs "Copy User Preferences"
  62.     Widget_Message .newprefs msg -aspect 1000 -text "
  63. Welcome to Exmh $exmh(version)
  64.  
  65. It appears you have not run Exmh since the [file tail $pref(userDefaults)] 
  66. and other related files moved in to the ~/.exmh directory.
  67.  
  68. Is it ok if Exmh copies the files to your ~/.exmh directory?  Once you 
  69. have verified that Exmh is functioning properly, you can delete the 
  70. old files by hand.
  71. "
  72.  
  73.     Widget_Frame .newprefs rim Pad {top expand fill}
  74.     .newprefs.rim configure -bd 10
  75.    
  76.     Widget_Frame .newprefs.rim but Menubar {top fill}
  77.     Widget_AddBut .newprefs.rim.but yes "Yes" PreferencesDoCopyFiles
  78.     Widget_AddBut .newprefs.rim.but no "No, Exit" {destroy .newprefs ; exit }
  79.     tkwait window .newprefs
  80. }
  81.  
  82. proc PreferencesCopyDone { movedFiles } {
  83.     Widget_Toplevel .filesmoved "Files Copied"
  84.     Widget_Message .filesmoved msg -aspect 1000 -text "
  85. The following files have been copied, and the copies have been renamed.  
  86. Once you have verified that Exmh is working properly, you can delete 
  87. these files.
  88.  
  89. $movedFiles
  90. "
  91.  
  92.     Widget_Frame .filesmoved rim Pad {top expand fill}
  93.     .filesmoved.rim configure -bd 10
  94.  
  95.     Widget_Frame .filesmoved.rim but Menubar {top fill}
  96.     Widget_AddBut .filesmoved.rim.but ok "OK" {destroy .filesmoved }
  97.     tkwait window .filesmoved
  98. }
  99.  
  100. proc PreferencesDoCopyFiles { } {
  101.     if {[file exists [glob ~]/.exmh-defaults] 
  102.     && ![file exists [glob ~]/.exmh/exmh-defaults]} {
  103.     catch {exec cp -r [glob ~]/.exmh-defaults [glob ~]/.exmh/exmh-defaults}
  104.     append movedList ".exmh-defaults\n"
  105.     }
  106.     
  107.     if {[file exists [glob ~]/.exmh-defaults-mono]
  108.         && ![file exists [glob ~]/.exmh/exmh-defaults-mono]} {
  109.         catch {exec cp -r [glob ~]/.exmh-defaults-mono [glob ~]/.exmh/exmh-defaults-mono}
  110.         append movedList ".exmh-defaults-mono\n"
  111.     }
  112.  
  113.     if {[file exists [glob ~]/.exmh-defaults-color]
  114.         && ![file exists [glob ~]/.exmh/exmh-defaults-color]} {
  115.         catch {exec cp -r [glob ~]/.exmh-defaults-color [glob ~]/.exmh/exmh-defaults-color}
  116.         append movedList ".exmh-defaults-color\n"
  117.     }
  118.  
  119.     if {[file exists [glob ~]/.exmh_addrs] 
  120.     && ![file exists [glob ~]/.exmh/exmh_addrs]} {
  121.     catch {exec cp -r [glob ~]/.exmh_addrs [glob ~]/.exmh/exmh_addrs}
  122.         append movedList ".exmh_addrs\n"
  123.     }
  124.  
  125.     if {[file exists [glob ~]/.exmh_addrs.bak] 
  126.     && ![file exists [glob ~]/.exmh/exmh_addrs.bak]} {
  127.     catch { exec cp -r [glob ~]/.exmh_addrs.bak [glob ~]/.exmh/exmh_addrs.bak}
  128.         append movedList ".exmh_addrs.bak\n"
  129.     }
  130.     
  131.     if {[file exists [glob ~]/.exmh-images] 
  132.     && ![file exists [glob ~]/.exmh/exmh-images]} {
  133.     catch { exec cp -r [glob ~]/.exmh-images [glob ~]/.exmh/exmh-images}
  134.         append movedList ".exmh-images\n"
  135.     }
  136.     
  137.     if {[file exists [glob ~]/.exmhbindings] 
  138.     && ![file exists [glob ~]/.exmh/exmhbindings]} {
  139.     catch { exec cp -r [glob ~]/.exmhbindings [glob ~]/.exmh/exmhbindings}
  140.         append movedList ".exmhbindings\n"
  141.     }
  142.     
  143.     if {[file exists [glob ~]/.exmhsedit] 
  144.     && ![file exists [glob ~]/.exmh/exmhsedit]} {
  145.     catch { exec cp -r [glob ~]/.exmhsedit [glob ~]/.exmh/exmhsedit}
  146.         append movedList ".exmhsedit\n"
  147.     }
  148.     catch {destroy .newprefs}
  149.     PreferencesCopyDone "$movedList"
  150. }
  151.  
  152. proc PreferencesReadFile { basename level } {
  153.     if [file exists $basename] {
  154.     if [catch {option readfile $basename $level} err] {
  155.         Exmh_Status "Error reading '$basename': $err"
  156.     }
  157.     }
  158.  
  159.     if {[winfo depth .] > 4} {
  160.     if [file exists $basename-color] {
  161.         if [catch {option readfile $basename-color $level} err] {
  162.         Exmh_Status "Error in $basename-color: $err"
  163.         }
  164.     }
  165.     } else {
  166.     if [file exists $basename-mono] {
  167.         if [catch {option readfile $basename-mono $level} err] {
  168.         Exmh_Status "Error in $basename-mono: $err"
  169.         }
  170.     }
  171.     }
  172. }
  173. proc Preferences_Add { id text prefs } {
  174.     global pref
  175.  
  176.     # Set up the table that drives the UI layout
  177.     set ix [lsearch $pref(panes) $id]
  178.     if {$ix < 0} {
  179.     lappend pref(panes) $id
  180.     set pref($id,prefs) $prefs
  181.     set pref($id,text) $text
  182.     } else {
  183.     foreach p $prefs {
  184.         lappend pref($id,prefs) $p
  185.     }
  186.     if {[string length $text] > 0} {
  187.         append pref($id,text) \n$text
  188.     }
  189.     }
  190.  
  191.     # Initialize the global variable from the option database,
  192.     # else the default value supplied.
  193.  
  194.     foreach item $prefs {
  195.     set varName [PrefVar $item]
  196.     set xresName [PrefXres $item]
  197.     set value [PrefValue $varName $xresName]
  198.     set default [PrefDefault $item]
  199.     Exmh_Debug Pref_Add $varName $value
  200.     if {$value == {}} {
  201.         # Set variables that are still not set
  202.         switch -regexp -- $default {
  203.         ^ON$        {PrefValueSet $varName 1}
  204.         ^OFF$        {PrefValueSet $varName 0}
  205.         "^CHOICE "    {PrefValueSet $varName [lindex $default 1]}
  206.         default        {PrefValueSet $varName $default}
  207.         }
  208.     } else {
  209.         # Warp booleans to 0 or 1
  210.         if {$default == "OFF" || $default == "ON"} {
  211.         switch -- $value {
  212.             0 -
  213.             1         { # ok as is }
  214.             true -
  215.             True -
  216.             TRUE     {PrefValueSet $varName 1}
  217.             false -
  218.             False -
  219.             FALSE     {PrefValueSet $varName 0}
  220.             default {
  221.             catch {puts stderr "Bogus boolean value $value for Xresource $xresName"}
  222.             PrefValueSet $varName 0
  223.             }
  224.         }
  225.         } elseif {[regexp {^[0-9]+$} $default]} {
  226.         # Clean up and validate integer values
  227.             PrefValueSet $varName [set value [string trim $value \ \t\n\r]]
  228.         if [catch {expr int($value)}] {
  229.             PrefValueSet $varName $default
  230.         }
  231.         }
  232.     }
  233.     }
  234. }
  235. # Return the value of the given variable,
  236. # or the value from the xresource database,
  237. # or {} if neither exist
  238. proc PrefValue { _var _xres } {
  239.     upvar #0 $_var var
  240.     if [info exists var] {
  241.     return $var
  242.     }
  243.     set var [option get . $_xres {}]
  244. }
  245. # set the value of the variable
  246. proc PrefValueSet { _var _value } {
  247.     upvar #0 $_var var
  248.     if {[catch {
  249.     set var $_value
  250.     } err]} {
  251.     # The above set sometimes breaks when traces on preference
  252.     # variables have bugs in them.  This error lets us find out
  253.     # what the variable is.
  254.  
  255.     error "Broken trace on [list set $_var $_value]: $err"
  256.     }
  257. }
  258. proc PrefEntrySet { entry varName } {
  259.     PrefValueSet $varName [$entry get]
  260. }
  261. proc PreferencesDismiss {{ix {}}} {
  262.     global exwin pref
  263.     Exwin_Dismiss .pref$ix
  264.     catch {PreferencesNukeItemHelp .prefitemhelp}
  265.     if {$ix == {}} {
  266.     catch {Exwin_Dismiss .prefhelp}
  267.     set ix 0
  268.     foreach id $pref(panes) {
  269.         catch {Exwin_Dismiss .pref$ix}
  270.         incr ix
  271.     }
  272.     }
  273. }
  274. proc PreferencesDelete {} {
  275.     global pref
  276.     catch {PreferencesNukeItemHelp .prefitemhelp}
  277.     catch {Exwin_Dismiss .prefhelp}
  278.     set ix 0
  279.     foreach id $pref(panes) {
  280.     catch {Exwin_Dismiss .pref$ix}
  281.     incr ix
  282.     }
  283.     Exwin_Dismiss .pref
  284. }
  285.  
  286. proc PreferencesHelp {} {
  287.     Help Preferences "Help for Preferences"
  288. }
  289.  
  290. proc Preferences_Dialog {} {
  291.     global pref
  292.     if [Exwin_Toplevel .pref "Exmh Preferences" Pref] {
  293.     set buttons .pref.but
  294.     $buttons.quit configure -command {PreferencesDismiss}
  295.     Widget_AddBut $buttons save Save {PreferencesSave}
  296.     Widget_AddBut $buttons reset "Reset All" {Preferences_Reset}
  297.     Widget_AddBut $buttons help Help {PreferencesHelp}
  298.  
  299.     set body [Widget_Frame .pref b Rim]
  300.     $body configure -borderwidth 2 -relief raised
  301.     set body [Widget_Frame $body b Pad]
  302.     $body configure -borderwidth 10
  303.     set body [Widget_Frame $body body Body]
  304.  
  305.     set maxWidth 0
  306.     foreach id $pref(panes) {
  307.         set len [string length $id]
  308.         if {$len > $maxWidth} {
  309.         set maxWidth $len
  310.         }
  311.     }
  312.     Widget_AddBut $body font Fonts Font_Dialog    {top}
  313.     $body.font configure -width $maxWidth
  314.     set i 0
  315.     foreach id $pref(panes) {
  316.         Widget_AddBut $body but$i $id [list PreferencesSectionDialog $id] \
  317.         {top}
  318.         $body.but$i configure -width $maxWidth
  319.         incr i
  320.     }
  321.     wm protocol .pref WM_DELETE_WINDOW PreferencesDelete
  322.     }
  323. }
  324.  
  325. proc PreferencesSectionDialog { id } {
  326.     global pref env
  327.     set ix [lsearch $pref(panes) $id]
  328.     if {$ix < 0} {
  329.     return
  330.     }
  331.     set buttons .pref$ix.but
  332.     if [Exwin_Toplevel .pref$ix "Exmh Preferences - $id" Pref] {
  333.     $buttons.quit configure -command [list PreferencesDismiss $ix]
  334.     wm protocol .pref$ix WM_DELETE_WINDOW [list PreferencesDismiss $ix]
  335.     wm minsize .pref$ix 25 2
  336.     Widget_AddBut $buttons reset Reset [list Preferences_Reset $id]
  337.     if $pref(helpInOneWindow) {
  338.         Widget_AddBut $buttons help Help [list PreferencesPaneHelp $id]
  339.     }
  340.     Widget_AddBut $buttons next Next [list PreferencesNext $ix] {left}
  341.     Widget_AddBut $buttons prev Prev [list PreferencesNext $ix -1] {left}
  342.  
  343.     Widget_Label $buttons label {left fill} -text "Click labels for more details"
  344.  
  345.     set body [Widget_Frame .pref$ix b Rim]
  346.     $body configure -borderwidth 2 -relief raised
  347.     set body [Widget_Frame $body b Pad]
  348.     $body configure -borderwidth 10
  349.     set body [Widget_Frame $body body Body]
  350.  
  351.     if !$pref(helpInOneWindow) {
  352.         set txt [Widget_Text [Widget_Frame $body text] 4]
  353.         $txt insert 1.0 $pref($id,text)
  354.         $txt configure -state disabled
  355.     }
  356.     set maxWidth 0
  357.     foreach item $pref($id,prefs) {
  358.         set len [string length [PrefComment $item]]
  359.         if {$len > $maxWidth} {
  360.         set maxWidth $len
  361.         }
  362.     }
  363.     foreach item $pref($id,prefs) {
  364.         PreferencesDialogItem $body $id $item $maxWidth
  365.     }
  366.     }
  367.     set pref(label) $buttons.label
  368. }
  369. proc PreferencesNext { ix {i 1}} {
  370.     global pref
  371.     global exwin
  372.     set geo [string trimleft [wm geometry .pref$ix] -x0123456789]
  373.     Exwin_Dismiss .pref$ix
  374.     catch {PreferencesNukeItemHelp .prefitemhelp}
  375.     incr ix $i
  376.     set id [lindex $pref(panes) $ix]
  377.     if {$id != {}} {
  378.     PreferencesSectionDialog $id
  379.     wm geometry .pref$ix $geo
  380.     }
  381. }
  382.  
  383. proc PreferencesDialogItem { frame id item width } {
  384.     global pref
  385.     incr pref(uid)
  386.     set f [Widget_Frame $frame p$pref(uid) Preference {top fill}]
  387.     Widget_Label $f label {left fill} \
  388.     -text [PrefComment $item] -width $width
  389.     
  390.     if $pref(helpInOneWindow) {
  391.     bind $f.label <1> [list PreferencesPaneHelp $id [PrefXres $item]]
  392.     } else {
  393.     bind $f.label <1> [list PreferencesItemHelp  %X %Y [PrefHelp $item]]
  394.     }
  395.  
  396.     set default [PrefDefault $item]
  397.     switch -regexp -- $default {
  398.     ^(ON|OFF)$    {
  399.         # This is a boolean
  400.         set varName [PrefVar $item]
  401.         Widget_CheckBut $f check "On" $varName {left}
  402.         $f.check config -command [list PrefBooleanFixup $f.check $varName]
  403.         PrefBooleanFixup $f.check $varName
  404.     }
  405.     "^CHOICE "    {
  406.         # This is a list of choices
  407.         foreach choice [lreplace $default 0 0] {
  408.         incr pref(uid)
  409.         Widget_RadioBut $f c$pref(uid) $choice [PrefVar $item] {left}
  410.         }
  411.     }
  412.     default     {
  413.         # This is a string or numeric
  414.         global PrefEntry
  415.         Widget_Entry $f entry {left fill expand} -width 10
  416.         set PrefEntry([PrefVar $item]) $f.entry
  417.  
  418.         set varName [PrefVar $item]
  419.         $f.entry insert 0 [uplevel #0 [list set $varName]]
  420.         Widget_BindEntryCmd $f.entry <Return> \
  421.         [list PrefEntrySet %W $varName]
  422.     }
  423.     }
  424. }
  425. proc PrefBooleanFixup { check varName } {
  426.     upvar #0 $varName var
  427.     if {$var} {
  428.     $check config -text On
  429.     } else {
  430.     $check config -text Off
  431.     }
  432. }
  433. proc PreferencesItemHelp { x y text } {
  434.     global pref
  435.     catch {destroy .prefitemhelp}
  436.     if {$text == {}} {
  437.     return
  438.     }
  439.     set self [Widget_Toplevel .prefitemhelp "Item help" Itemhelp [expr $x+10] [expr $y+10]]
  440.     wm transient .prefitemhelp .pref
  441.     Widget_Message $self msg -text $text -aspect 1500
  442.     bind $self.msg <1> {PreferencesNukeItemHelp .prefitemhelp}
  443.     $pref(label) configure -text "Click on popup or another label"
  444.     Visibility_Wait .prefitemhelp
  445. }
  446. proc PreferencesNukeItemHelp { t } {
  447.     global pref
  448.     $pref(label) configure -text ""
  449.     destroy $t
  450. }
  451.  
  452. proc PreferencesSave { {nodismiss {}} } {
  453.     global pref PrefEntry
  454.     set newstuff {}
  455.     foreach id $pref(panes) {
  456.     foreach item $pref($id,prefs) {
  457.         set varName [PrefVar $item]
  458.         set xresName [PrefXres $item]
  459.         if [info exists PrefEntry($varName)] {
  460.         PrefValueSet $varName [$PrefEntry($varName) get]
  461.         }
  462.         set value [PrefValue $varName $xresName]
  463.         lappend newstuff [format "%s\t%s" *${xresName}: $value]
  464.     }
  465.     }
  466.     Preferences_RewriteSection "Lines below here automatically added" "End Preferences State" $newstuff
  467.     Preferences_Reset
  468.     if {$nodismiss == {}} {
  469.     PreferencesDismiss
  470.     }
  471.     Background_Preferences
  472. }
  473. proc Preferences_RewriteSection { boundary1 boundary2 newstuff } {
  474.     global pref
  475.     if [catch {
  476.     set old [open $pref(userDefaults) r]
  477.     set oldValues [split [string trimright [read $old] \n] \n]
  478.     close $old
  479.     }] {
  480.     set oldValues {}
  481.     }
  482.     if [catch {open $pref(userDefaults).new w} out] {
  483.     Exmh_Status "Cannot save in $pref(userDefaults).new: $out" warn
  484.     return
  485.     }
  486.     set state "before"
  487.     foreach line $oldValues {
  488.     case $state {
  489.         "before" {
  490.         if {[string compare $line "!!! $boundary1"] == 0} {
  491.             set state "inside"
  492.             puts $out "!!! $boundary1"
  493.             puts $out "!!! [exec date]"
  494.             puts $out "!!! Do not edit below here"
  495.             foreach item $newstuff {
  496.             puts $out $item
  497.             }
  498.             puts $out "!!! $boundary2"
  499.         } else {
  500.             puts $out $line
  501.         }
  502.         }
  503.         "inside" {
  504.         if {[string compare $line "!!! $boundary2"] == 0} {
  505.             set state "after"
  506.         }
  507.         }
  508.         "after" {
  509.         puts $out $line
  510.         }
  511.     }
  512.     }
  513.     if {$state == "before"} {
  514.     puts $out "!!! $boundary1"
  515.     puts $out "!!! [exec date]"
  516.     puts $out "!!! Do not edit below here"
  517.     foreach item $newstuff {
  518.         puts $out $item
  519.     }
  520.     puts $out "!!! $boundary2"
  521.     }
  522.     close $out
  523.     set new [glob $pref(userDefaults).new]
  524.     set old [file root $new]
  525.     if [catch {Mh_Rename $new $old} err] {
  526.     Exmh_Status "Cannot install $new: $err"
  527.     return
  528.     }
  529. }
  530. proc Preferences_ReadSection { boundary1 boundary2 } {
  531.     global pref
  532.     if [catch {
  533.     set old [open $pref(userDefaults) r]
  534.     set oldValues [split [string trimright [read $old] \n] \n]
  535.     close $old
  536.     }] {
  537.     set oldValues {}
  538.     }
  539.     set state "before"
  540.     set results {}
  541.     foreach line $oldValues {
  542.     case $state {
  543.         "before" {
  544.         if {[string compare $line "!!! $boundary1"] == 0} {
  545.             set state "inside"
  546.         }
  547.         }
  548.         "inside" {
  549.         if {![regexp {^!!!} $line]} {
  550.             lappend results $line
  551.         }
  552.         if {[string compare $line "!!! $boundary2"] == 0} {
  553.             break
  554.         }
  555.         }
  556.     }
  557.     }
  558.     return $results
  559. }
  560. proc Preferences_Reset { {id_in {}} } {
  561.     global pref
  562.     # Re-read user defaults
  563.     option clear
  564.     PreferencesReadFile $pref(appDefaults) startup
  565.     PreferencesReadFile $pref(localDefaults) 50
  566.     PreferencesReadFile $pref(userDefaults) user
  567.     # Now set variables
  568.     if {$id_in == {}} {
  569.     set id_in $pref(panes)
  570.     } else {
  571.     set id_in [list $id_in]
  572.     }
  573.     foreach id $id_in {
  574.     foreach item $pref($id,prefs) {
  575.         set varName [PrefVar $item]
  576.         set xresName [PrefXres $item]
  577.         set xresval [option get . $xresName {}]
  578.         if {$xresval != {}} {
  579.         set default $xresval
  580.         } else {
  581.         set default [PrefDefault $item]
  582.         }
  583.         switch -regexp -- $default {
  584.         ^ON$        {PrefValueSet $varName 1}
  585.         ^OFF$        {PrefValueSet $varName 0}
  586.         "^CHOICE "    {PrefValueSet $varName [lindex $default 1]}
  587.         default        {
  588.                 global PrefEntry
  589.                 if [info exists PrefEntry($varName)] {
  590.                     set entry $PrefEntry($varName)
  591.                     $entry delete 0 end
  592.                     $entry insert 0 $default
  593.                 }
  594.                 PrefValueSet $varName $default
  595.         }
  596.         }
  597.     }
  598.     }
  599. }
  600. proc Preferences_Tweak { _varName } {
  601.     # Change a single setting in the preferences database.
  602.     # This assumes a preference value has been changes from outside the
  603.     # preferences UI.
  604.     global pref PrefEntry
  605.     set done 0
  606.     foreach id $pref(panes) {
  607.     foreach item $pref($id,prefs) {
  608.         set varName [PrefVar $item]
  609.         if {[string compare $varName $_varName] == 0} {
  610.         set xresName [PrefXres $item]
  611.         upvar #0 $varName x
  612.         if [info exists PrefEntry($varName)] {
  613.             # Update the preferences user interface.
  614.             $PrefEntry($varName) delete 0 end
  615.             $PrefEntry($varName) insert 0 $x
  616.         }
  617.         set done 1
  618.         break
  619.         }
  620.     }
  621.     if {$done} break
  622.     }
  623.     if {! $done} {
  624.     error "No resource associated with $_varName"
  625.     }
  626.     # Change one line
  627.     if [catch {open $pref(userDefaults) r} old] {
  628.     # No existing preferences, better save all of them
  629.     PreferencesSave nodismiss
  630.     return
  631.     }
  632.     if [catch {open $pref(userDefaults).new w} out] {
  633.     Exmh_Status "Cannot save in $pref(userDefaults).new: $out" warn
  634.     close $old
  635.     return
  636.     }
  637.     foreach line [split [read -nonewline $old] \n] {
  638.     if [regexp "^\\*$xresName:" $line] {
  639.         puts $out "*$xresName: $x"
  640.         set done 1
  641.     } else {
  642.         puts $out $line
  643.     }
  644.     }
  645.     close $old
  646.     close $out
  647.     set new [glob $pref(userDefaults).new]
  648.     set old [file root $new]
  649.     if [catch {Mh_Rename $new $old} err] {
  650.     Exmh_Status "Cannot install $new: $err"
  651.     return
  652.     }
  653. }
  654. proc Preferences_Resource { _varName _rname _default } {
  655.     set _rval [option get . $_rname {}]
  656.     if {$_rval != {}} {
  657.     PrefValueSet $_varName $_rval
  658.     } else {
  659.     PrefValueSet $_varName $_default
  660.     }
  661. }
  662.  
  663. proc PreferencesPaneHelp { id {gotoxres {}} } {
  664.     global pref
  665.     set ix [lsearch $pref(panes) $id]
  666.     set top .prefhelplong$ix
  667.     set t $top.t
  668.     set numLines 8
  669.  
  670.     if [Exwin_Toplevel $top "Exmh '$id' Preferences Help" Help] {
  671.     wm group $top .pref$ix
  672.     Widget_AddBut $top.but help Help {PreferencesHelp}
  673.     Widget_Label  $top.but label {left fill} -text "Help for '$id' Preferences"
  674.     Widget_Text $top $numLines -setgrid true
  675.     $t tag configure headings -underline 1
  676.     $t insert end $id\n\n
  677.     $t tag add headings 1.0 "end -2c"
  678.     $t insert end $pref($id,text)\n\n\n
  679.     foreach item $pref($id,prefs) {
  680.         PreferencesPaneHelpText $t $item
  681.     }
  682.     $t mark set help4_ 1.0
  683.     $t configure -state disabled
  684.     }
  685.  
  686.     # make as much help text visible
  687.     $t see end
  688.     $t see help4_$gotoxres
  689. }
  690. proc PreferencesPaneHelpText { t item } {
  691.     set res [PrefXres $item] 
  692.     set var [PrefVar  $item] 
  693.     $t insert end [PrefComment $item]\n\n
  694.     $t tag add headings "insert -2 line" "insert -1c"
  695.     $t mark set help4_$res "insert -2 line"
  696.     foreach line [split [PrefHelp $item] \n] {
  697.     $t insert end \t$line\n
  698.     }
  699.     $t insert end "\n\ttk resource:  $res\n\ttcl variable: $var\n\n"
  700. }
  701.